*  FILE NAME: CASHPHAR.PRG
*  BY: NURJADI PURNAMA
*  DATE: December 4, 1995
*  DESC:
*  CALLED BY:
*  DATA FILES:
ANOD=.T.
F5='DP_DISC'
F9='DRUGS'
F10='DISPOS'
F11='VCARE_DR'
F12='VCARE_DI'
SELE 9
SET EXCLU OFF
USE &DR&F9 INDEX &DR&F9
SELE 10
SET EXCLU OFF
USE &DR&F10 INDE &DR&F10
SELE 11
SET EXCLU OFF
USE &DR&F11 INDE &DR&F11

SELE 5
SET EXCLU OFF
USE &DR&F5 INDE &DR&F5


SELE 12
SET EXCLU OFF
USE &DR&F12 INDE &DR&F12
SELE 3
SET EXCLU OFF
USE &DR&F3
do while anod
   set color to bg+/b
   @ 9,0 clea to 21,79
   @ 22,0 CLEA TO 24,45
   store space(5) to DRUGK,dispk
   store 0 to cntd,crd,DQNT
   STORE SPACE(1) TO DRUGIN,DISPIN
**
** Dickson - after the Dispos. code changed to new format
**         - to allow the user to search in 2 characters
   STORE SPACE(2) TO DISPIN
**

   pl16=0
   do box2 with 9,0," ","DRUGS ITEMS","DISPOSABLE ITEMS",'gr+','b','gr+','n',pl6,.f.,.t.
   IF LASTKEY()=27
      ANOD=.F.
      LOOP
   ENDI
   if PL6=1
      DRUGK=space(5)
      DO BOXlab WITH 12,0,'Enter Drugs Code :','DRUGK','gr+','B','gr+','N',5,.F.,.T.
      if DRUGK=SPACE(5)
         do boxi with 12,28,'Enter initial of Drug (trade name)  :','drugin','gr+','b','gr+','n',.f.,.t.
         DO CASH405
         if drugk=space(5)
            loop
         endif
      ENDIF
      SET COLOR TO BG+/B
      @ 9,0 CLEA TO 21,79
      SELE 9
      SEEK DRUGK
      IF .NOT. EOF()
         NMDR=DRUG_NAME
         TPDR=DRUG_TYPE
         SLUN=TRIM(SELL_UNIT)+' '+TRIM(DRUG_QANT)+' '+TRIM(DRUG_UNIT)
         SEUN=SELL_UNIT
****     EMDR=EMPLOYEE
****     IF TPPAT='0' .OR. TPPAT='9'
****        UNPR=EMP_PRICE
****     ELSE
****        UNPR=SALE_PRICE
****     ENDIF

         UNPR=SALE_PRICE
         UNNI=DRUG_UNIT
         QANT=DRUG_QANT
         HLDR=HEALTHLINE
         set colo to gr+/b
         @ 9,1 to 13,77 double
         @ 10,3 say 'Drug             : '+DRUGK+'   '+ALLTRIM(NMDR)+' '+ALLTRIM(TPDR)+'  '+SLUN
         if aeadeci
            @ 12,3 say 'Price ('+AEACURR+')      :'+TRANS(unPR,'###,###.##')+' Per '+alltrim(seun)
         else
            @ 12,3 say 'Price ('+AEACURR+')      :'+TRANS(unPR,'##,###,###')+' Per '+alltrim(seun)
         endif
         DO BOXN WITH 14,1,'Quantity         : ','DQNT','999','gr+','B','gr+','n','999','1',.F.,.f.
         if dqnt=1
            DO BOXT WITH 14,30,'Per '+SEUN,'gr+','B',.F.,.F.
         else
            DO BOXT WITH 14,30,'Per '+alltrim(SEUN)+'S','gr+','B',.F.,.F.
         endif
         TOTPR=UNPR*DQNT
**
**    Amended by dickson (30/12/98) - to allow the user to override the Total Price
**       - this is to cater for the CMPP plan which does not charge the patient
**         for certain type of drugs/disposable items used
**
         IF LEN(ALLTRIM(PRGNM)) > 0

** Buu - Start (12/9/03): to discount 30% of all procedure && DD for SOS EXPAT STAFF 
** Buu - Remove on 1/3/04 as Simon requested / Huy add on 5 Dec 05 as requested by SL
**IF ALLTRIM(PRGNM) = "TOURIST" .OR. ALLTRIM(PRGNM) = "VISITOR"
**               @ 17,03 SAY 'Total Price ('+AEACURR+'):  '+TRANS(TOTPR,'#,###,###.##')+ '  before 20% **surcharge for TOURIST and VISITOR'
**                TOTPR = TOTPR * 1.2
**           ENDIF 




IF ALLTRIM(PRGNM) = "SOS EXPAT STAFF"
               @ 17,03 SAY 'Total Price ('+AEACURR+'):  '+TRANS(TOTPR,'#,###,###.##')+ '  before 50% discount for SOS EXPAT STAFF'
                TOTPR = TOTPR * 0.50
           ENDIF
** Buu - End (12/9/03)/ Remove on 1/3/04  / Huy add on 5 Dec 05 as requested by SL


** Buu - Start (23/09/04) V-CARE LITE, DISCOUNT 10%
            IF ALLTRIM(PRGNM) = "V-CARE LITE"
                @ 17,03 SAY 'Total Price ('+AEACURR+'):  '+TRANS(TOTPR,'#,###,###.##')+ '  before 10% discount for V-CARE LITE'
                TOTPR = TOTPR * 0.90
            ENDIF
** Buu - End (23/09/04)

** Buu - Start (23/09/04) V-CARE STARTER, DISCOUNT 10%
            IF ALLTRIM(PRGNM) = "V-CARE STARTER"
                @ 17,03 SAY 'Total Price ('+AEACURR+'):  '+TRANS(TOTPR,'#,###,###.##')+ '  before 10% discount for V-CARE STARTER'
                TOTPR = TOTPR * 0.90
            ENDIF
** Buu - End (23/09/04)

** Buu - Start (23/09/04) V-CARE WELL, DISCOUNT 5%
**            IF ALLTRIM(PRGNM) = "V-CARE WELL"
**                @ 17,03 SAY 'Total Price ('+AEACURR+'):  '+TRANS(TOTPR,'#,###,###.##')+ '  before 5% discount for V-CARE WELL'
**                TOTPR = TOTPR * 0.95
**            ENDIF
** Buu - End (23/09/04)








	** V-Care Program - Wellness Plan as required by SL in March 1 2006 - refer to CMS discount/surcharge programme V7
	** Discount 100% for some procedures and DD and 5% for the rest
		IF (ALLTRIM(PRGNM) = "V-CARE WELL")
			**DISC=0
		** SEARCH IN VCARE_DI TO GET THE DRUGS CODE THAT DISCOUNT 100% IN VCARE_DR
			SELE 11
			GO TOP
			SEEK PRGNM+DRUGK
			IF .NOT. EOF()
	   			DISC=100
			ELSE 
				DISC=5
		    	ENDIF
			IF DISC=100 
	                @ 17,03 SAY 'Total Price ('+AEACURR+'):  '+TRANS(TOTPR,'#,###,###.##')+ '  before 100% discount for V-CARE WELL'
   	          TOTPR = TOTPR * 0.0
			ENDIF
			IF DISC=5
	                @ 17,03 SAY 'Total Price ('+AEACURR+'):  '+TRANS(TOTPR,'#,###,###.##')+ '  before 5% discount for V-CARE WELL'
   	          TOTPR = TOTPR * 0.95
			ENDIF
		ENDIF

** Buu - END (28/11/03)

** Dickson -End (09-Feb-01)END

            @ 18,03 SAY 'Price Pay ('+AEACURR+')  : '
            @ 18,23 GET  TOTPR PICT '#,###,###.##'
            READ
         ELSE
           DO BOXTD WITH 16,1,'Total Price ('+AEACURR+'):'+TRANS(TOTPR,'#,###,###'),'Total Price ('+AEACURR+'):'+TRANS(TOTPR,'##,###.##'),'gr+','b',.F.,.f.
         ENDIF
**
**     - End amended by dickson

         do box2 with 22,0,'Do You Want To :','CONFIRM','MODIFY','gr+','r','gr+','N',PL7,.F.,.t.
         IF PL7=2
            loop
         ELSE
            NDRUG=NDRUG+1
            IF TPPAT='0' .OR. TPPAT='9'
****           IF EMDR
               IF HLDR
                  HLRES=.T.
                  HPRIC=0
                  PPRIC=0
                  MPRIC=0
                  MSRES=.F.
               ELSE
                  HLRES=.F.
                  HPRIC=0
                  PPRIC=TOTPR
                  MPRIC=0
                  MSRES=.F.
               ENDIF
            ELSE
               IF HLDR .AND. HEALTH .AND. .NOT. HLVOID
                  HLRES=.T.
                  HPRIC=TOTPR
                  PPRIC=0
                  MPRIC=0
                  MSRES=.F.
               ELSE
                     HLRES=.F.
                     HPRIC=0
                     MPRIC=0
                     PPRIC=TOTPR
                     MSRES=.F.
               ENDIF
            ENDIF
            SELE 3
            DO CASHPHDR
            TOTL=TOTL+PPRIC
            PTOTL=PTOTL+PPRIC
**
**  amended by Dickson
**   - why this is omitted by the cash void amendment by jakarta??
**   - this Variable is requird by the CASHPRIN.PRG !!
**   - added back by Dickson 09/01/99

           TOTLPH = TOTLPH+PPRIC
**
**  end amendment by Dickson
         Endif
      ELSE
         LOOP
      endif

      DO BOXTD WITH 22,46,'TOTAL PAYABLE ('+AEACURR+') :'+TRANS(TOTL,'#,###,###'),'TOTAL PAYABLE ('+AEACURR+') :'+TRANS(TOTL,'##,###.##'),'GR+','B',.F.,.T.
   else
      DispK=space(5)






      DO BOXlab WITH 12,0,'Enter Disposable Code :','DispK','gr+','B','gr+','N',5,.F.,.T.
      if Dispk=SPACE(5)
**
**    dickson - 17/4/99 
**         do boxi with 12,33,'Enter initial of Disposable item :','dispin','gr+','b','gr+','n',.f.,.t.
         do boxo with 12,33,'Enter initial of Disposable item :','dispin','gr+','b','gr+','n',2,.f.,.t.
**
         DO CASH406
         if dispk=space(5)
            loop
         endif
      endif
      SET COLOR TO BG+/B
      @ 9,0 CLEA TO 20,79
      SELE 10
      SEEK DISPK
      IF .NOT. EOF()
         NMDS=DISP_NAME
         TPDS=DISP_TYPE
         SLUN=TRIM(SELL_UNIT)+' '+TRIM(DISP_QANT)+' '+TRIM(DISP_UNIT)
         SEUN=SELL_UNIT

****     EMDS=EMPLOYEE
****     IF TPPAT='0' .OR. TPPAT='9'
****        UNPS=EMP_PRICE
****     ELSE
****        UNPS=SALE_PRICE
****     ENDIF

         UNPS=SALE_PRICE
         UNNI=DISP_UNIT
         QANT=DISP_QANT
         HLDS=HEALTHLINE
         set colo to gr+/b
         @ 9, 1 to 13,77 double
         @ 10,3 say 'Disposable       : '+DISPK+'   '+ALLTRIM(NMDS)+' '+ALLTRIM(TPDS)+'  '+SLUN
         if aeadeci
            @ 12,3 say 'Price ('+AEACURR+')      : '+TRANS(UNPS,'##,###.##')+' Per '+alltrim(seun)
         else
            @ 12,3 say 'Price ('+AEACURR+')      : '+TRANS(UNPS,'#,###,###')+' Per '+alltrim(seun)
         endif
         DO BOXT WITH 14,30,'Per '+SEUN,'gr+','B',.F.,.F.
         DO BOXN WITH 14,1,'Quantity         : ','DQNT','999','Gr+','B','gr+','N','999','1',.F.,.f.
         TOTPR=UNPS*DQNT
**
**    Amended by dickson (30/12/98) - to allow the user to override the Total Price
**       - this is to cater for the CMPP plan which does not charge the patient
**         for certain type of drugs/disposable items used
**
         IF LEN(ALLTRIM(PRGNM)) > 0

** Dickson -Start- 09-Feb-01 : to give 15% for all Drugs & Disposable items - SIMON's Request
** Dickson -STart- 14-07-01  : remove the default 15% discount forall BP GMS DD
**            IF ALLTRIM(PRGNM) = "BP GMS CONTRACT"
**                @ 17,03 SAY 'Total Price ('+AEACURR+'):  '+TRANS(TOTPR,'#,###,###.##')+ '  before 15% discount for BP'
**                TOTPR = TOTPR * 0.85
**            ENDIF
** Dickson -End (09-Feb-01)END
** Dickson -Start- 16-07-01  : to give 15% discount on DD for all BP NATIONAL STF program  
** Buu - Remove discount for BP 9/8/2004
**            IF ALLTRIM(PRGNM) = "BP NATIONAL STF"
  **              @ 17,03 SAY 'Total Price ('+AEACURR+'):  '+TRANS(TOTPR,'#,###,###.##')+ '  before 15% discount for BP'
    **            TOTPR = TOTPR * 0.85
      **      ENDIF
** Buu - End 9/8/2004
** Dickson -End 16-07-01 
** Dickson -Start- 28/08/2001  : to give 10% discount on DD for all UNILEVER CARE program  
** remove discount for Unilever : Simon requested 11/3/2004
**            IF ALLTRIM(PRGNM) = "UNILEVER CARE"
**                @ 17,03 SAY 'Total Price ('+AEACURR+'):  '+TRANS(TOTPR,'#,###,###.##')+ '  before 10% discount for UNILEVER'
**                TOTPR = TOTPR * 0.90
**            ENDIF
** Dickson -End 28/08/2001  

** Buu -Start- 12/09/2001  : to give 30% discount on DD for all SOS VN EXPAT STAFF program  
** Buu - Remove on 1/3/04 as Simon requested
**            IF ALLTRIM(PRGNM) = "SOS EXPAT STAFF"
**                @ 17,03 SAY 'Total Price ('+AEACURR+'):  '+TRANS(TOTPR,'#,###,###.##')+ '  before 30% discount for SOS EXPAT STAFF'
**                TOTPR = TOTPR * 0.70
**            ENDIF
** Buu -End 12/09/2001  

** Buu - Start (04/11/03): to discount 5% of all procedures and D&D for SEA GAMES
**            IF ALLTRIM(PRGNM) = "SEA GAMES"
 **               @ 17,03 SAY 'Total Price ('+AEACURR+'):  '+TRANS(TOTPR,'#,###,###.##')+ '  before 5% discount for SEA GAMES'
  **              TOTPR = TOTPR * 0.95
    **        ENDIF
** Buu - End (04/11/03)


** HUY END 3 OCT 06 ' No surcharge on some item in DP_DICS



** V-Care Program - Prosperity/WELLNESS Plan
** Discount 100% for some DISPOSABLE IN VCARE_DI and 5% for the rest
** Buu - start (28/11/03)
**		IF (ALLTRIM(PRGNM) = "V-CARE PROSP") .OR. (ALLTRIM(PRGNM) = "V-CARE WELL")**
**		** SEARCH IN VCARE_DI TO GET THE DISPO CODE THAT DISCOUNT 100%
**			SELE 12
**			GO TOP
**			SEEK DISPK
**			IF .NOT. EOF()
   **				DISC=100
**			ELSE 
**				DISC=5
**		    	ENDIF
**			IF DISC=100 
**	      	    @ 17,03 SAY 'Total Price ('+AEACURR+'):  '+TRANS(TOTPR,'#,###,###.##')+ '  before 100% discount for V-CARE PROSP/WELL'
**	                TOTPR = TOTPR * 0.0
**			ENDIF
**			IF DISC=5
**		          @ 17,03 SAY 'Total Price ('+AEACURR+'):  '+TRANS(TOTPR,'#,###,###.##')+ '  before 5% discount for V-CARE PROSP/WELL'
   **   	          TOTPR = TOTPR * 0.95
**			ENDIF
**		ENDIF

** Buu - END (28/11/03)
            @ 18,03 SAY 'Price Pay ('+AEACURR+')  :'
            @ 18,23 GET  TOTPR PICT '#,###,###.##'
            READ

         ELSE
            DO BOXTD WITH 16,1,'Total Price ('+AEACURR+'):'+TRANS(TOTPR,'#,###,###'),'Total Price ('+AEACURR+'):'+TRANS(TOTPR,'##,###.##'),'gr+','b',.F.,.f.
         ENDIF

**     - End amended by dickson 

         do box2 with 22,0,'Do You Want To :','CONFIRM','MODIFY','gr+','r','gr+','N',PL7,.F.,.t.
         IF PL7=2
            loop
         ELSE
            NDISP=NDISP+1

            IF TPPAT='0' .OR. TPPAT='9'
****           IF EMDS
               IF HLDS
                  HLRES=.F.
                  HPRIC=0
                  PPRIC=0
                  MPRIC=0
                  MSRES=.F.
               ELSE
                  HLRES=.F.
                  HPRIC=0
                  PPRIC=TOTPR
                  MPRIC=0
                  MSRES=.F.
               ENDIF
            ELSE
               IF HLDS .AND. HEALTH .AND. .NOT. HLVOID
                  HLRES=.T.
                  HPRIC=TOTPR
                  PPRIC=0
                  MPRIC=0
                  MSRES=.F.
               ELSE
                     HLRES=.F.
                     HPRIC=0
                     PPRIC=TOTPR
                     MPRIC=0
                     MSRES=.F.
               ENDIF
            ENDIF
            SELE 3
            DO CASHPHDS
            TOTL=TOTL+PPRIC
            PTOTL=PTOTL+PPRIC
**
**  amended by Dickson
**   - why this is omitted by the cash void amendment by jakarta??
**   - this Variable is requird by the CASHPRIN.PRG !!
**   - added back by Dickson 09/01/99

           TOTLPH = TOTLPH+PPRIC
**
**  end amendment by Dickson

         endif
      ELSE
         LOOP
      endif

      DO BOXTD WITH 22,46,'TOTAL PAYABLE ('+AEACURR+') :'+TRANS(TOTL,'#,###,###'),'TOTAL PAYABLE ('+AEACURR+') :'+TRANS(TOTL,'##,###.##'),'GR+','B',.F.,.T.
   ENDIF
   SET COLOR TO BG+/B
   @ 9,0 CLEA TO 18,79
   @ 19,0 CLEA TO 24,45
   DO BOX2 WITH 22,0,'Other Drugs or Disposable items :','YES','NO','gr+','r','gr+','N',PL8,.F.,.t.
   if pl8=2
      anod=.f.
   endif
ENDDO
*Formatted by: Herman T Ver. 7.1  on December 4, 1995.
